home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / nrpas13.zip / MNEWT.DEM < prev    next >
Text File  |  1991-04-29  |  2KB  |  81 lines
  1. PROGRAM d9r13(input,output);
  2. (* driver for routine MNEWT *)
  3. CONST
  4.    ntrial=5;
  5.    tolx=1.0e-6;
  6.    n=4;
  7.    np=n;
  8.    tolf=1.0e-6;
  9. TYPE
  10.    glnarray = ARRAY [1..n] OF real;
  11.    glnbyn = ARRAY [1..n,1..n] OF real;
  12.    glindx = ARRAY [1..n] OF integer;
  13.    glnpbynp = glnbyn;
  14. VAR
  15.    i,j,k,kk : integer;
  16.    xx : real;
  17.    x,beta : glnarray;
  18.    alpha : glnbyn;
  19.  
  20. PROCEDURE usrfun(x: glnarray; n: integer; VAR alpha: glnbyn;
  21.        VAR beta: glnarray);
  22. (* Programs using routine USRFUN must define the types
  23. TYPE
  24.    glnarray = ARRAY [1..n] OF real;
  25.    glnbyn = ARRAY [1..n,1..n] OF real;
  26. in the main routine. *)
  27. BEGIN
  28.    alpha[1,1] := -2.0*x[1];
  29.    alpha[1,2] := -2.0*x[2];
  30.    alpha[1,3] := -2.0*x[3];
  31.    alpha[1,4] := 1.0;
  32.    alpha[2,1] := 2.0*x[1];
  33.    alpha[2,2] := 2.0*x[2];
  34.    alpha[2,3] := 2.0*x[3];
  35.    alpha[2,4] := 2.0*x[4];
  36.    alpha[3,1] := 1.0;
  37.    alpha[3,2] := -1.0;
  38.    alpha[3,3] := 0.0;
  39.    alpha[3,4] := 0.0;
  40.    alpha[4,1] := 0.0;
  41.    alpha[4,2] := 1.0;
  42.    alpha[4,3] := -1.0;
  43.    alpha[4,4] := 0.0;
  44.    beta[1] := sqr(x[1])+sqr(x[2])+sqr(x[3])-x[4];
  45.    beta[2] := -sqr(x[1])-sqr(x[2])-sqr(x[3])-sqr(x[4])+1.0;
  46.    beta[3] := -x[1]+x[2];
  47.    beta[4] := -x[2]+x[3]
  48. END;
  49.  
  50. (*$I MODFILE.PAS *)
  51. (*$I LUBKSB.PAS *)
  52.  
  53. (*$I LUDCMP.PAS *)
  54.  
  55. (*$I MNEWT.PAS *)
  56.  
  57. BEGIN
  58.    FOR kk := 1 to 2 DO BEGIN
  59.       FOR k := 1 to 3 DO BEGIN
  60.          xx := 0.2*k*(2*kk-3);
  61.          writeln('Starting vector number',k:2);
  62.          FOR i := 1 to 4 DO BEGIN
  63.             x[i] := xx+0.2*i;
  64.             writeln('x[':7,i:1,']  :=  ',x[i]:5:2)
  65.          END;
  66.          writeln;
  67.          FOR j := 1 to ntrial DO BEGIN
  68.             mnewt(1,x,n,tolx,tolf);
  69.             usrfun(x,n,alpha,beta);
  70.             writeln('i':5,'x[i]':13,'f':13);
  71.             FOR i := 1 to n DO BEGIN
  72.                writeln(i:5,x[i]:14:6,-beta[i]:15:6)
  73.             END;
  74.             writeln;
  75.             writeln('press RETURN to continue...');
  76.             readln
  77.          END
  78.       END
  79.    END
  80. END.
  81.